MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 04 - 1988/04.04 Apr 88/forth sources/fmath.68881

Text File | 1988-03-07 | 3.0 KB | 289 lines | [TEXT/EDIT]

only forth also assembler also sane
vocabulary f68881
also f68881 definitions

code f>2
    add.l    #20,d7
    move.l    d7,a0
    move.l    -(a0),-(a7)
    move.l    -(a0),-(a7)
    subq.l    #2,a7
    move.w    -(a0),-(a7)
    fmove.x    (a7)+,fp0
    move.l    -(a0),-(a7)
    move.l    -(a0),-(a7)
    subq.l    #2,a7
    move.w    -(a0),-(a7)
    fmove.x    (a7)+,fp1
    add.l    #10,a0
    rts
end-code mach

code f>1
    add.l    #10,d7
    move.l    d7,a0
    move.l    -(a0),-(a7)
    move.l    -(a0),-(a7)
    subq.l    #2,a7
    move.w    -(a0),-(a7)
    fmove.x    (a7)+,fp0
    rts
end-code mach

code 1>f
    fmove.x fp0,-(a7)
    move.w    (a7)+,(a0)+
    addq.l    #2,a7
    move.l    (a7)+,(a0)+
    move.l    (a7)+,(a0)+
    sub.l     #10,d7
    rts
end-code mach

code f+
    f>2
    fadd.x fp1,fp0
    1>f
    rts
end-code

code f-
    f>2
    fsub.x fp1,fp0
    1>f
    rts
end-code

code f/
    f>2
    fdiv.x fp1,fp0
    1>f
    rts
end-code

code f*
    f>2
    fmul.x fp1,fp0
    1>f
    rts
end-code

code fmod
    f>2
    fmod.x fp1,fp0
    1>f
    rts
end-code

code frem
    f>2
    frem.x fp1,fp0
    1>f
    rts
end-code

code fabs
    f>1
    fabs.x    fp0
    1>f
    rts
end-code

code facos
    f>1
    facos.x    fp0
    1>f
    rts
end-code

code fasin
    f>1
    fasin.x    fp0
    1>f
    rts
end-code

code fatan
    f>1
    fatan.x    fp0
    1>f
    rts
end-code

code fatanh
    f>1
    fatanh.x fp0
    1>f
    rts
end-code

code fcos
    f>1
    fcos.x    fp0
    1>f
    rts
end-code

code fcosh
    f>1
    fcosh.x    fp0
    1>f
    rts
end-code

code fe^x
    f>1
    fetox.x    fp0
    1>f
    rts
end-code

code fe^x-1
    f>1
    fetoxm1.x fp0
    1>f
    rts
end-code

code fgetexp
    f>1
    fgetexp.x fp0
    1>f
    rts
end-code

code fgetman
    f>1
    fgetexp.x fp0
    1>f
    rts
end-code

code fint
    f>1
    fint.x fp0
    1>f
    rts
end-code

code fintrz
    f>1
    fintrz.x fp0
    1>f
    rts
end-code

code fln
    f>1
    flogn.x fp0
    1>f
    rts
end-code

code fln+1
    f>1
    flognp1.x fp0
    1>f
    rts
end-code

code flog10
    f>1
    flog10.x fp0
    1>f
    rts
end-code

code flog2
    f>1
    flog2.x fp0
    1>f
    rts
end-code

code fneg
    f>1
    fneg.x fp0
    1>f
    rts
end-code

code fsin
    f>1
    fsin.x fp0
    1>f
    rts
end-code

code fsinh
    f>1
    fsinh.x fp0
    1>f
    rts
end-code

code fsqrt
    f>1
    fsqrt.x fp0
    1>f
    rts
end-code

code ftan
    f>1
    ftan.x fp0
    1>f
    rts
end-code

code ftanh
    f>1
    ftanh.x fp0
    1>f
    rts
end-code

code f10^x
    f>1
    ftentox.x fp0
    1>f
    rts
end-code

code f2^x
    f>1
    ftwotox.x fp0
    1>f
    rts
end-code

fp

also forth definitions
code fnull1
    f>1
    1>f
    rts
end-code

code fnull2
    f>2
    1>f
    rts
end-code

: bmark1 counter 1.0 100000 0 do fdup fnull1 fdrop loop timer fdrop ;
: bmark2 counter 4.3352 100000 0 do fdup fe^x fdrop loop timer fdrop ;
: bmark3 counter 3.5 4.5 100000 0 do fover fover fnull2 fdrop loop timer fdrop fdrop ;
: bmark4 counter 3.5 4.5 100000 0 do fover fover f+ fdrop loop timer fdrop fdrop ;
: bmark5 counter 3.5 4.5 100000 0 do fover fover f* fdrop loop timer fdrop fdrop ;

also sane

: smark1 counter 1.0 10000 0 do fdup fnull1 fdrop loop timer fdrop ;
: smark2 counter 4.3352 10000 0 do fdup fe^x fdrop loop timer fdrop ;
: smark3 counter 3.5 4.5 10000 0 do fover fover fnull2 fdrop loop timer fdrop fdrop ;
: smark4 counter 3.5 4.5 10000 0 do fover fover f+ fdrop loop timer fdrop fdrop ;
: smark5 counter 3.5 4.5 10000 0 do fover fover f* fdrop loop timer fdrop fdrop ;